home *** CD-ROM | disk | FTP | other *** search
/ The PC-SIG Library 10 / The PC-Sig Library - Shareware for the IBM PC and Compatibles (PC-SIG)(Tenth Edition Disks 1-2804)(1991).iso / PC_SIGCD / 04 / 4 / DISK0445.ZIP / CHASE.PAS < prev    next >
Pascal/Delphi Source File  |  1980-01-01  |  11KB  |  372 lines
  1. PROGRAM CHASE;
  2.               { Version 2.01 - 11/03/84 - Mike Watkins }
  3.  
  4. CONST   MAN        = 'O';                     {SYMBOL FOR THE MAN}
  5.         EDGE       = '|';                     {SYMBOL FOR THE FENCE}
  6.         OBST       = '*';                     {SYMBOL FOR AN OBSTRUCTION}
  7.         ROBOT      = 'R';                     {SYMBOL FOR A ROBOT}
  8.         BLANK      = ' ';                     {AN ASCII BLANK}
  9.  
  10.         DROB       =   3;                     {STARTING NO OF ROBOTS}
  11.         ROBMAX     =  20;                     {MAX NO OF ROBOTS ALLOWED}
  12.         XMAX       =  39;                     {MAX HORIZONTAL FIELD DIMENSION}
  13.         YMAX       =  14;                     {MAX VERTICAL FIELD DIMENSION}
  14.  
  15.         TOP        =   2;                     {SPACE ABOVE FIELD}
  16.         SIDE       =   5;                     {SPACE TO LEFT OF FIELD}
  17.         Size       =  80;                     { define your console screen size here }
  18.  
  19. type
  20.        Line        =  string[Size];           { total line length }
  21.  
  22. VAR     FIELD      : PACKED ARRAY[0..XMAX,0..YMAX] OF CHAR;
  23.         AGAIN,PLAY : BOOLEAN;
  24.         WIN        : BOOLEAN;
  25.         MI,MJ      : INTEGER;                 {COORDINATES OF THE MAN}
  26.         R          : INTEGER;                 {NUMBER OF ROBOTS LEFT}
  27.         RI,RJ      : ARRAY[1..ROBMAX] OF INTEGER;  {ROBOT COORDINATES}
  28.         RNUM       : REAL;
  29.         DIFF       : INTEGER;                 {DIFFICULTY}
  30.         IDIFF      : 0..10;                   {INITIAL DIFFICULTY}
  31.         GAMENU     : INTEGER;                 {GAME NUMBER}
  32.         M          : CHAR;
  33.         NROB       : INTEGER;                 {NUMBER OF ROBOTS}
  34.         WINS       : INTEGER;                 {NUMBER OF GAMES WON}
  35.         GOODCHAR   : SET OF CHAR;             {GOOD CHARACTERS}
  36.         MOVES      : INTEGER;                 {COUNT OF MOVES}
  37.         CRASH      : INTEGER;                 {NO OF ROBOTS "CRASHED"}
  38.         I          : integer;
  39.  
  40. FUNCTION RND(LO,HI:INTEGER):INTEGER;          {RANDOM NUMBER GENERATOR}
  41. VAR  Q       :REAL;
  42.      I       :INTEGER;
  43. BEGIN
  44.   REPEAT
  45.     RNUM:=RNUM*21.182813+31.415917;
  46.     RNUM:=RNUM-TRUNC(RNUM);
  47.     I:=TRUNC(RNUM*HI);
  48.   UNTIL I>LO;
  49.   RND:=I;
  50. END;
  51.  
  52.  
  53. PROCEDURE DOMOVE(COL,ROW:INTEGER;SYMBOL:CHAR); {DISPLAY SYMBOL AT I,J ON FIELD}
  54. BEGIN
  55.   GOTOXY(COL+1,ROW+1);         {POSITION CURSOR}
  56.   WRITE(SYMBOL)
  57. END;            {END OF DOMOVE PROCEDURE}
  58.  
  59.  
  60. { These next two procedures allow centering of lines based on your console
  61.   screen size }
  62.  
  63. procedure Center (L:Line); { centers text without a cr & lf }
  64. begin
  65.      for I := 1 to (Size - Length(L)) div 2 do write (' ');
  66.      write(L);
  67. end;
  68.  
  69. procedure Centerln (L:Line); { centers text with a cr & lf}
  70. begin
  71.      for I := 1 to (Size - Length(L)) div 2 do write (' ');
  72.      writeln(L);
  73. end;
  74.  
  75.  
  76. PROCEDURE INSTRUCTIONS;                       {DISPLAY INSTRUCTIONS}
  77. VAR M:CHAR;
  78. BEGIN
  79.   ClrScr;
  80.   Centerln ('WELCOME TO THE WONDERFUL, EXCITING, GAME OF CHASE!');
  81.   writeln;Center ('Would you like instructions (Y/N): ');
  82.   READ(Kbd,M);write(M);
  83.   M:=UPCASE(M);
  84.   IF M='Y' THEN
  85.   BEGIN
  86.     WRITELN;WRITELN;
  87.     Centerln ('HERE ARE SOME INSTRUCTIONS:');writeln;
  88.     Centerln ('You, "O",are in a HIGH VOLTAGE maze.');
  89.     Centerln ('The ROBOT computers, "R", are trying to destroy you.');
  90.     Centerln ('To win, you must destroy the computers.');
  91.     Centerln ('This is done by running them into fence posts, "*",');
  92.     Centerln ('or by running them into each other.');
  93.     Centerln ('The diagram below the maze shows how you can move,');
  94.     Centerln ('the ROBOTS will try to follow you.');
  95.     Centerln ('There are 3 ROBOTS to start for a BEGINNER.');
  96.     Centerln ('The number will increase as you win games !');
  97.     WRITELN;
  98.     Centerln ('GOOD LUCK!!!!!')
  99.   END;
  100. END;                                          {END OF INSTRUCTIONS}
  101.  
  102.  
  103. PROCEDURE STARTGAME;
  104. VAR    SK: CHAR;
  105. BEGIN
  106. WRITELN;WRITELN;WRITELN;
  107.   Center('Enter a number followed by RETURN: ');READLN(RNUM);
  108.   IF RNUM=0 THEN RNUM:=12.345;
  109.   WHILE RNUM > 200 DO RNUM:=RNUM-200;
  110.   ClrScr;
  111.   Centerln ('HOW GOOD A PLAYER ARE YOU ?');
  112.   WRITELN;
  113.   Centerln ('Beginner     - B');
  114.   Centerln ('Intermediate - I');
  115.   Centerln ('Expert       - E');
  116.   Centerln ('Old Pro      - P');
  117.   WRITELN;
  118.   Center ('Type in your skill: ');
  119.   READ (Kbd,SK);write (SK);
  120.   SK:=UPCASE(SK);
  121.   WRITELN;
  122.   WHILE NOT (SK IN ['B','I','E','P']) DO
  123.   BEGIN
  124.     writeln;Center ('What was that again please ? ');
  125.     READ (Kbd,SK);write (SK);
  126.     SK:=UPCASE(SK);
  127.     WRITELN
  128.   END;
  129.   CASE SK OF
  130.     'B': IDIFF:=0;
  131.     'I': IDIFF:=1;
  132.     'E': IDIFF:=3;
  133.     'P': IDIFF:=5;
  134.   END;
  135. END;
  136.  
  137.  
  138. PROCEDURE INITIALIZE;   {SET UP BLANK FIELD SURROUNDED BY FENCE}
  139. VAR I,J:INTEGER;
  140. BEGIN
  141.   FOR I:=0 TO XMAX DO
  142.   BEGIN
  143.     FOR J:=0 TO YMAX DO
  144.     IF((I=0) OR (I=XMAX) OR (J=0) OR (J=YMAX)) THEN FIELD[I,J]:=EDGE
  145.       ELSE FIELD[I,J]:=BLANK
  146.    END;
  147. END;    {END OF INITIALIZE}
  148.  
  149.  
  150. PROCEDURE INNERFIELD;   {SET UP MAN, ROBOTS AND OBSTRUCTIONS}
  151. VAR I,J,L,POSTS:INTEGER;
  152. BEGIN
  153.   MI:=RND(0,XMAX); MJ:=RND(0,YMAX); {LOCATE MAN AT ANY RANDOM POSITION}
  154.   FIELD[MI,MJ]:=MAN;
  155.   R:=NROB;
  156.   FOR L:=1 TO R DO                            {NOW DO R ROBOTS}
  157.   BEGIN
  158.     REPEAT
  159.       I:=RND(0,XMAX);J:=RND(0,YMAX);
  160.     UNTIL FIELD[I,J]=BLANK;
  161.     FIELD[I,J]:=ROBOT;
  162.     RI[L]:=I;
  163.     RJ[L]:=J
  164.   END;
  165.   POSTS:=RND(25,35);                          {NOW SET UP 25 TO 35 POSTS}
  166.   FOR L:=1 TO POSTS DO
  167.   BEGIN
  168.     REPEAT
  169.       IF DIFF>3 THEN
  170.       BEGIN
  171.         I:=RND(0,XMAX);
  172.         J:=RND(0,YMAX)
  173.       END ELSE
  174.       BEGIN
  175.         I:=RND(1,XMAX-1);
  176.         J:=RND(1,YMAX-1)
  177.       END;
  178.     UNTIL FIELD[I,J]=BLANK;
  179.     FIELD[I,J]:=OBST
  180.     END;
  181. END;                                          {END OF INNERFIELD}
  182.  
  183.  
  184. PROCEDURE MAP;                                {DISPLAY PLAYING FIELD}
  185. VAR I,J:INTEGER;
  186. BEGIN
  187.   ClrScr;
  188.   WRITELN('GAME  DIFF   ROBOTS    WINS    MOVE':79);
  189.   WRITE(' ':44,GAMENU:3,DIFF:5,R:8,WINS:10,MOVES:8);
  190.   GOTOXY(1,1);
  191.   FOR J:=0 TO YMAX DO
  192.   BEGIN
  193.     FOR I:=0 TO XMAX DO WRITE(FIELD[I,J]);
  194.     WRITELN
  195.   END;
  196.   WRITELN;
  197.   WRITELN('1 2 3      Q = Quit');
  198.   WRITELN('4 X 6      5 = No Move');
  199.   WRITE('7 8 9                  MOVE => ');
  200. END;                                          {END OF MAP}
  201.  
  202. PROCEDURE MOVE;                               {ENTER YOUR MOVE FROM KEYBOARD}
  203. VAR     M : INTEGER;
  204.         C : CHAR;
  205.       BAD : BOOLEAN;
  206. BEGIN
  207.   BAD:=FALSE;
  208.   REPEAT
  209.     WRITE(' ',CHR(8));
  210.     READ (Kbd,C);write (C);
  211.     C:=UPCASE(C);
  212.     IF NOT (C IN GOODCHAR) THEN
  213.     BEGIN
  214.       GOTOXY(5,22);
  215.       BAD:=TRUE;
  216.       WRITE('Bad move, please try again! ':33,CHR(7))
  217.     END;
  218.   UNTIL (C IN GOODCHAR);
  219.   IF BAD THEN
  220.     BEGIN
  221.       GOTOXY(5,22);
  222.       WRITE(' ':40);
  223.       GOTOXY(11,23);
  224.     END;
  225.   IF C='Q' THEN
  226.     BEGIN
  227.      PLAY:=FALSE;
  228.      WIN:=FALSE
  229.     END;
  230.   M:=ORD(C)-48;
  231.   FIELD[MI,MJ]:=BLANK;
  232.   DOMOVE(MI,MJ,BLANK);
  233.       CASE M OF
  234.   7: BEGIN MI:=MI-1; MJ:=MJ-1 END;
  235.   8: MJ:=MJ-1;
  236.   9: BEGIN MI:=MI+1; MJ:=MJ-1 END;
  237.   4: MI:=MI-1;
  238.   5: ;
  239.   6: MI:=MI+1;
  240.   1: BEGIN MI:=MI-1; MJ:=MJ+1 END;
  241.   2: MJ:=MJ+1;
  242.   3: BEGIN MI:=MI+1; MJ:=MJ+1 END
  243.      END;
  244.   MOVES:=MOVES+1;
  245.   IF FIELD[MI,MJ] = BLANK THEN
  246.     BEGIN
  247.       DOMOVE(MI,MJ,MAN);
  248.       FIELD[MI,MJ]:=MAN
  249.     END ELSE
  250.   BEGIN
  251.     IF FIELD[MI,MJ] = EDGE THEN
  252.     BEGIN
  253.       WIN:=FALSE;
  254.       PLAY:=FALSE;
  255.       WRITELN('OUCH, YOU GOT ELECTROCUTED!')
  256.     END ELSE
  257.     BEGIN
  258.       IF FIELD[MI,MJ] = ROBOT THEN
  259.       WRITELN('THWACK! YOU RAN INTO A ROBOT (TURKEY!)') ELSE
  260.       WRITELN('ZZAP! YOU RAN INTO AN ELECTIFIED POST');
  261.       WIN:=FALSE;
  262.       PLAY:=FALSE
  263.     END;
  264.   END;
  265. END;            {END OF MOVE PROCEDURE}
  266.  
  267.  
  268. PROCEDURE ROBOTMOVE;    {COMPUTE MOVE FOR R OR FEWER ROBOTS}
  269. VAR M,L,I,J:INTEGER;
  270. BEGIN
  271.   FOR L:=1 TO NROB DO
  272.   BEGIN
  273.     IF((RI[L]<>0) AND (WIN)) THEN
  274.     BEGIN
  275.       FIELD[RI[L],RJ[L]]:=BLANK;
  276.       DOMOVE(RI[L],RJ[L],BLANK);
  277.       IF MI>RI[L] THEN RI[L]:=RI[L]+1;
  278.       IF MI<RI[L] THEN RI[L]:=RI[L]-1;
  279.       IF MJ>RJ[L] THEN RJ[L]:=RJ[L]+1;
  280.       IF MJ<RJ[L] THEN RJ[L]:=RJ[L]-1;
  281.       I:=RI[L];J:=RJ[L];
  282.       IF FIELD[I,J]=BLANK THEN
  283.       BEGIN
  284.         FIELD[RI[L],RJ[L]]:=ROBOT;
  285.         DOMOVE(I,J,ROBOT)
  286.       END
  287.       ELSE
  288.       BEGIN
  289.         IF ((FIELD[I,J]=OBST) OR (FIELD[I,J]=ROBOT))  THEN
  290.         BEGIN
  291.           GOTOXY(XMAX+13,CRASH+4);
  292.           CRASH:=CRASH+1;
  293.           WRITELN('CRASH!! YOU GOT ONE!!');
  294.           R:=R-1;
  295.           GOTOXY(54,2);             {CHANGE NO OF ROBOTS}
  296.           WRITE(R:8);
  297.           RI[L]:=0;
  298.           IF R=0 THEN
  299.           BEGIN
  300.             GOTOXY(XMAX+17,CRASH+4);
  301.             WRITELN('GOOD WORK!');
  302.             GOTOXY(XMAX+9,CRASH+5);
  303.             WRITELN('YOU HAVE DESTROYED THEM ALL!!');
  304.             WIN:=TRUE;
  305.             PLAY:=FALSE
  306.           END;
  307.         END;
  308.       END;
  309.       IF FIELD[RI[L],RJ[L]]=FIELD[MI,MJ] THEN
  310.       BEGIN
  311.         WRITELN('ZAP! A COMPUTER GOT YOU!');
  312.         WIN:=FALSE;
  313.         PLAY:=FALSE
  314.       END;
  315.     END;
  316.  END;
  317. END;                                         {END OF ROBOTMOVE PROCEDURE}
  318.  
  319.  
  320.  
  321. BEGIN             {START OF MAIN PROGRAM}
  322.   GOODCHAR:=['1'..'9','Q'];
  323.   GAMENU:=1;
  324.   WINS:=0;
  325.   AGAIN:=TRUE;
  326.   PLAY:=TRUE;     {INITIALIZE QUIT}
  327.   INSTRUCTIONS;   {DISPLAY INSTRUCTIONS}
  328.   STARTGAME;      {INPUT STARTING POSITION AND SKILL LEVEL}
  329.   DIFF:=IDIFF;    {INITIAL DIFFICULTY LEVEL}
  330.   NROB:=DROB+DIFF*2;  {INITIAL NUMBER OF ROBOTS}
  331.   WHILE AGAIN DO
  332.   BEGIN
  333.     MOVES:=1;WIN:=TRUE;CRASH:=0;
  334.     INITIALIZE;     {CLEARS FIELD[X,Y]}
  335.     INNERFIELD;     {SETS UP PLAYING FIELD}
  336.     WHILE PLAY DO
  337.     BEGIN
  338.       IF MOVES=1 THEN MAP ELSE
  339.       BEGIN
  340.         GOTOXY(71,2);
  341.         WRITELN(MOVES:8);
  342.         DOMOVE(30,18,BLANK)             {INPUT NEXT MOVE}
  343.       END;
  344.       MOVE;         {LETS YOU MOVE}
  345.       IF(PLAY) THEN ROBOTMOVE     {MOVES THE ROBOTS}
  346.     END;
  347.     GOTOXY(1,22);
  348.     Center ('Would you like to play again? (Y/N) ');
  349.     READ(Kbd,M);write (M);
  350.     M:=UPCASE(M);
  351.     IF M='N' THEN AGAIN:=FALSE ELSE
  352.     BEGIN
  353.       PLAY:=TRUE;
  354.       GAMENU:=GAMENU+1;
  355.       IF WIN THEN
  356.       BEGIN
  357.         WINS:=WINS+1;
  358.         IF WINS>2 THEN DIFF:=IDIFF+1;
  359.         IF WINS>5 THEN DIFF:=IDIFF+2;
  360.         IF WINS>8 THEN DIFF:=IDIFF+3;
  361.         IF WINS>11 THEN DIFF:=IDIFF+4;
  362.         IF WINS>15 THEN DIFF:=IDIFF+6;
  363.         IF WINS>20 THEN DIFF:=IDIFF+8;
  364.         IF WINS>30 THEN DIFF:=IDIFF+12;
  365.         NROB:=DROB+2*DIFF
  366.       END;
  367.     END;
  368.   END;
  369. END.
  370. 0 THEN DIFF:=IDIFF+8;
  371.         IF WINS>30 THEN DIFF:=IDIFF+12;
  372.         NROB:=DROB+2*D